home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / n_b_v203.zip / FGETKEY.DMO < prev    next >
Text File  |  1996-07-04  |  8KB  |  210 lines
  1. $if 0
  2.     ┌──────────────────────────╖                        PowerBASIC v3.20
  3.  ┌──┤          DASoft          ╟──────────────────────┬──────────────────╖
  4.  │  ├──────────────────────────╢    Copyright 1995    │ DATE: 1996-03-08 ╟─╖
  5.  │  │ FILE NAME   FGETKEY .DMO ║          by          ╘════════════════─ ║ ║
  6.  │  │                          ║  Don Schullian, Jr.                     ║ ║
  7.  │  ╘══════════════════════════╝                                         ║ ║
  8.  │ A license is hereby granted to the holder to use this source code in  ║ ║
  9.  │ any program, commercial or otherwise,  without receiving the express  ║ ║
  10.  │ permission of the copyright holder and without paying any royalties,  ║ ║
  11.  │ as long as this code is not distributed in any compilable format.     ║ ║
  12.  │  IE: source code files, PowerBASIC Unit files, and printed listings   ║ ║
  13.  ╘═╤═════════════════════════════════════════════════════════════════════╝ ║
  14.    │                ....................................                   ║
  15.    ╘═══════════════════════════════════════════════════════════════════════╝
  16.  
  17. this program will accept data from one file and create, format and/or test
  18. so you can add any keys that may come into use or to create a smaller file.
  19.  
  20. InportFile$ MUST be found on the disk so it can be read in
  21. ExportFile$ is optional. If it is NULL then no file is written.
  22.  
  23. You will notice that KEYCODES.INC the file in the DMO directory is NOT the
  24. same as the file of the same name in ..\ directory. The file in DMO is more
  25. humanized for easy editing while the actual file in ..\ is more ready for
  26. PowerBASIC.
  27.  
  28. $endif
  29.  
  30. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  31. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  32.  
  33. $INCLUDE "DAS-NB01.INC"
  34.  
  35. InportFile$ = "DMO\KEYCODES.INC"
  36. ExportFile$ = "..\KEYCODES.INC"
  37.  
  38. DIM KeyVal%(300), KeyName$(300)             ' 300 should be enough!
  39.  
  40. COLOR 7, 0
  41. CLS
  42.  
  43. ? "┌───────────────────────────────────────────────────────────────────────
  44. ? "│ fGetKey% ()
  45. ? "│ KEYCODES.INC - DECLARED CONSTANTS FOR KEYS
  46. ? "├───────────────────────────────────────────────────────────────────────
  47. ? "│ fGetKey% and fAnyKey% are used throughout these libraries. fGetKey%
  48. ? "│ however, is NOT included in the library. You need to either import a
  49. ? "│ version of it from the help screen or write one of your own. This is
  50. ? "│ fGetKey% can be made to do many different things depending on the
  51. ? "│ requirements of your program(s). A version of fGetKey% can be found at
  52. ? "│ the bottom of this file. How it is used, what values it returns, etc.
  53. ? "│ are demonstrated here.
  54. ? "│ Have a look into KEYCODES.INC to see what values are returned for which
  55. ? "│ keys or/and you can $INCLUDE it in your program/unit files.
  56. ? "│
  57. ? "│ READ: FGETKEY.TXT
  58. ? "└─────────────────────────────────────────────────────────────────────────
  59.  
  60. IF LEN( DIR$( InportFile$ ) ) = 0 THEN          ' check if file is there
  61.   PRINT "SORRY BUT I CAN'T FIND "; InportFile$  ' nope! couldn't find it
  62.   PRINT
  63.   PRINT "PLEASE FIX THE CODE THEN RUN AGAIN."
  64.   END
  65. END IF
  66.  
  67. KeyName$(0) = "UNKNOWN KEY"                     ' just for display use
  68.  
  69. PRINT "READING: "; InportFile$                  ' read in file
  70. OPEN "I", #1, InportFile$                       ' and parce the variable
  71.   WHILE NOT EOF(1)                              ' from the values
  72.     LINE INPUT #1, L$                           ' if "(256 *" then the
  73.     L$ = EXTRACT$( L$, "'" )                    ' value will be converted
  74.     IF LEN( L$ ) = 0 THEN ITERATE               ' to it's INTEGER value
  75.     FOR P% = 1 TO 10
  76.       P$ = fGetPiece$( L$, 58, P% )
  77.       P$ = RTRIM$( LTRIM$( P$ ) )
  78.       IF P$ = "" THEN EXIT FOR
  79.       IF ASCII( P$ ) <> 37 THEN ITERATE
  80.       INCR Last%
  81.       KeyName$(Last%) = EXTRACT$( P$, "=" )
  82.       KeyName$(Last%) = RTRIM$( KeyName$(Last%) )
  83.       LongName% = MAX%( LongName%, LEN( KeyName$(Last%) ) )
  84.       P$ = fGetPiece$( P$, 61, 2 )
  85.       P$ = RTRIM$( LTRIM$( P$, ANY " (" ), ANY " )" )
  86.       X% = INSTR( P$, "*" )
  87.       KeyVal%(Last%) = VAL( MID$( P$, X%+1 ) )
  88.       IF X% > 0 THEN SHIFT LEFT KeyVal%(Last%), 8
  89.     NEXT
  90.   WEND
  91. CLOSE #1
  92.  
  93. INCR LongName%
  94. D$ = SPACE$( LongName% )                                  ' longest name
  95. FOR X% = 1 TO Last%                                       ' pad names to
  96.   KeyName$(X%) = LEFT$( KeyName$(X%) + D$, LongName% )    ' equal length
  97. NEXT
  98.  
  99. ARRAY SORT KeyName$(1) FOR Last%, COLLATE UCASE, TAGARRAY KeyVal%()
  100.  
  101. IF ( LEN( ExportFile$ ) > 0     )  AND _       ' export file creation
  102.    ( ExportFile$ <> InportFile$ ) THEN
  103.  
  104.   PRINT "WRITING: "; ExportFile$
  105.   OPEN "O", #1, ExportFile$
  106.     FOR X% = 1 TO Last%
  107.       D$ = KeyName$(X%) + "= &h" + fHEX$( KeyVal%(X%), 2 )
  108.       INCR X%, 1
  109.       IF X% =< Last% THEN
  110.         D$ = D$ + "  :  "
  111.         D$ = D$ + KeyName$(X%) + "= &h" + fHEX$(KeyVal%(X%), 2 )
  112.       END IF
  113.       PRINT #1, D$
  114.     NEXT
  115.   CLOSE #1
  116.  
  117. END IF
  118.  
  119. PRINT : PRINT "PRESS ANY KEY TO CONTINUE"          ' ready to ROCK!
  120. fGetKey
  121.  
  122. ' ─────────────────────────────────────────────────────────────────────────
  123. ' ────  test menu
  124. ' ─────────────────────────────────────────────────────────────────────────
  125. MENU_PRINT:
  126.   CLS
  127.   PRINT "(1)  TEST ALL
  128.   PRINT "(2)  START AT ....
  129.   PRINT "(3)  RANDOM KEYS
  130.   PRINT "(Q)  QUIT
  131.   MENU_LOOP:
  132.     SELECT CASE fGetKey%
  133.       CASE 49 : X% = 1 : GOTO TEST_ALL             ' 1
  134.       CASE 50 :        : GOTO START_WHERE          ' 2
  135.       CASE 51 :        : GOTO RANDOM_KEYS          ' 3
  136.       CASE 81, 113     : GOTO BYEBYE               ' Q
  137.     END SELECT
  138.     BEEP
  139.   GOTO MENU_LOOP
  140.  
  141. ' ─────────────────────────────────────────────────────────────────────────
  142. ' ────  end of program
  143. ' ─────────────────────────────────────────────────────────────────────────
  144. BYEBYE:
  145.   CLS
  146.   END
  147. ' ─────────────────────────────────────────────────────────────────────────
  148. ' ────  start where ever X% is in the list
  149. ' ─────────────────────────────────────────────────────────────────────────
  150. TEST_ALL:
  151.   CLS
  152.   PRINT "PRESS <Q> TO QUIT"
  153.   PRINT "PRESS THE REQUESTED KEY.
  154.   PRINT "IF YOU HEAR A <BEEP> THERE IS/HAS BEEN AN ERROR"
  155.  
  156.   DO
  157.     LOCATE 5, 1 : PRINT "PRESS: "; KeyName$(X%)
  158.     G% = fGetKey%
  159.     IF ( G% = 81 ) OR ( G% = 113 ) THEN EXIT LOOP
  160.     IF G% = KeyVal%(X%) THEN INCR X% ELSE BEEP
  161.   LOOP UNTIL X% > Last%
  162. GOTO MENU_PRINT
  163.  
  164.  
  165. ' ─────────────────────────────────────────────────────────────────────────
  166. ' ────  start in the middle of the list
  167. ' ─────────────────────────────────────────────────────────────────────────
  168. START_WHERE:
  169.   CLS
  170.   PRINT "PRESS THE STARTING KEY...."
  171.   PRINT "PRESS <Q> TO QUIT"
  172.   DO
  173.     G% = fGetKey%
  174.     ARRAY SCAN KeyVal%(1) FOR Last%, = G%, TO X%
  175.     IF X% > 0 THEN GOTO TEST_ALL ELSE BEEP
  176.   LOOP UNTIL ( G% = 81 ) OR ( G% = 113 )
  177. GOTO MENU_PRINT
  178.  
  179. ' ─────────────────────────────────────────────────────────────────────────
  180. ' ────  let's you press keys & tells you if they exist in the list or not
  181. ' ─────────────────────────────────────────────────────────────────────────
  182. RANDOM_KEYS:
  183.   DO
  184.     CLS
  185.     PRINT "PRESS <Q> TO QUIT"
  186.     LOCATE 3, 1 : PRINT "PRESS A KEY NOW"
  187.     G% = fGetKey%
  188.     IF ( G% = 81 ) OR ( G% = 113 ) THEN EXIT LOOP
  189.     ARRAY SCAN KeyVal%(1) FOR Last%, = G%, TO X%
  190.     PRINT "YOU PRESSED "; KeyName$(X%);
  191.     PRINT " THIS KEY'S VALUE IS &h"; fHex$( G%, 2 )
  192.     PRINT
  193.     PRINT "PRESS THE <ANY> KEY TO CONTINUE"
  194.     fGetKey%
  195.   LOOP
  196. GOTO MENU_PRINT
  197.  
  198. ' ─────────────────────────────────────────────────────────────────────────
  199. ' ───  this version of fGetKey% clears the keyboard buffer upon each
  200. ' ───  call and, there by, is a copy of fAnyKey%
  201. ' ─────────────────────────────────────────────────────────────────────────
  202. FUNCTION fGetKey% () LOCAL PUBLIC     ' return key-value
  203.   LOCAL G$                            '
  204.                                       '
  205.   WHILE INSTAT : G$ = INKEY$ : WEND   ' clear keyboard buffer
  206.   WHILE NOT INSTAT : WEND             ' await a key-press
  207.   FUNCTION = CVI( INKEY$ + CHR$(0) )  ' convert to INTEGER value
  208.